SPACE 2

home *** CD-ROM | disk | FTP | other *** search

/ SPACE 2 / SPACE - Library 2 - Volume 1.iso / apps / 142 / applic / spellpic.bas < prev next >

Wrap

BASIC Source File | 1987-06-15 | 17.8 KB | 656 lines

10 '**SPELLPIC by D. A. Brumleve*** 20 '********Copyright 1987********* 30 '*Released to the Public Domain* 40 '************Enjoy!************* 50 ' Initializations 60 openw 2 : fullw 2 : clearw 2 : ? ' Used by INTERPRETER only 70 gosub AESINIT:GOSUB INITIALIZE 80 icon%=1:default%=0 90 text$=" | SPELLPIC|By D. A. Brumleve|Copyright 1987|Public Domainware" 100 choices$="Let's play!" 110 COLOR 1,4,1,1,1:FILL 1,1 120 gosub formalert 130 icon%=1 140 default%=1 150 text$="Use lower case|letters to name the|pictures. Then press|'Return'." 160 choices$="OK." 170 color 1,3,1,1,1:fill 1,1 180 gosub formalert 190 randomize 0 200 DIM SEENIT(10) 210 for ii=1 to 10 220 T=INT(RND*20+1) 230 if ii=1 then goto 270 240 for j=1 to ii-1 250 if seenit(j)=t then goto 220 260 NEXT J 270 seenit(ii)=t 280 CLEARW 2 290 IF T=1 THEN GOSUB QUESTION1 300 IF T=2 THEN GOSUB QUESTION2 310 IF T=3 THEN GOSUB QUESTION3 320 IF T=4 THEN GOSUB QUESTION4 330 IF T=5 THEN GOSUB QUESTION5 340 IF T=6 THEN GOSUB QUESTION6 350 IF T=7 THEN GOSUB QUESTION7 360 IF T=8 THEN GOSUB QUESTION8 370 IF T=9 THEN GOSUB QUESTION9 380 IF T=10 THEN GOSUB QUESTION10 390 IF T=11 THEN GOSUB QUESTION11 400 IF T=12 THEN GOSUB QUESTION12 410 IF T=13 THEN GOSUB QUESTION13 420 IF T=14 THEN GOSUB QUESTION1A 430 IF T=15 THEN GOSUB QUESTION1B 440 IF T=16 THEN GOSUB QUESTION1C 450 IF T=17 THEN GOSUB QUESTION1D 460 IF T=18 THEN GOSUB QUESTION1E 470 IF T=19 THEN GOSUB QUESTION1F 480 IF T=20 THEN GOSUB QUESTION1G 490 next ii 500 CLEARW 2 510 color 1,2,1,1,1:fill 1,1 520 ICON%=1 530 DEFAULT%=0 540 TEXT$="Congratulations!|Do you want to play|the game again?" 550 choices$="Not now.|Great!" 560 gosub formalert 570 if choice%=2 then gosub delay:goto 210 580 CLEARW 2:ICON%=1:DEFAULT%=0 590 text$="If you enjoyed this|game, you may also|enjoy WORDPIC!" 600 choices$="I like that one, too!" 610 color 1,2,1,1,1:fill 1,1 620 gosub formalert 630 gosub delay:gosub delay 640 end 650 WRONGANSWER: 660 GOSUB DUDSOUND 670 CLEARW 2 680 ? "The word is not '"+w$+"'!" 690 ? "Try it again." 700 gosub delay:gosub delay 710 clearw 2:return 720 rightanswer: 730 gosub winsound 740 clearw 2 750 ? "Good for you!!!" 760 ? "The word is '"+w$+"'!" 770 gosub delay:gosub delay 780 return 790 question1: 800 ? "Type a name for the picture." 810 ?:?:?:? 820 gosub redbus 830 GOSUB DELAY:CLEARW 2 840 input w$ 850 if w$="bus" or w$="van" then gosub rightanswer:return 860 GOSUB WRONGANSWER 870 goto 790 880 question2: 890 ? "Name the picture." 900 ?:?:?:? 910 gosub car 920 gosub delay:gosub delay:clearw 2 930 input w$ 940 if w$="car" or w$="auto" or w$="automobile" then gosub rightanswer:return 950 gosub wronganswer 960 goto 880 970 question3: 980 ? "You can live in a ______." 990 ?:?:?:? 1000 gosub house 1010 gosub delay:gosub delay:clearw 2 1020 input w$ 1030 if w$="house" or w$="home" then gosub rightanswer:return 1040 gosub wronganswer 1050 goto 970 1060 question4: 1070 ? "You might fly to the moon" 1080 ? "in this. What is it?" 1090 ?:?:?:? 1100 gosub rocket 1110 gosub delay:gosub delay:clearw 2 1120 input w$ 1130 if w$="rocket" or w$="spaceship" then gosub rightanswer:return 1140 gosub wronganswer 1150 goto 1060 1160 question5: 1170 ? "You hit a ball with this." 1180 ? "What is it called?" 1190 ?:?:?:? 1200 gosub racket 1210 gosub delay:gosub delay:clearw 2 1220 input w$ 1230 if w$="racket" then gosub rightanswer:return 1240 gosub wronganswer 1250 goto 1160 1260 question6: 1270 ? "You might wear this on" 1280 ? "your foot. What is it?" 1290 ?:?:?:? 1300 gosub boot 1310 gosub delay:gosub delay:clearw 2 1320 input w$ 1330 if w$="boot" then gosub rightanswer:return 1340 gosub wronganswer 1350 goto 1260 1360 question7: 1370 ? "You could ride in this to" 1380 ? "cross a lake. What is it?" 1390 ?:?:?:? 1400 gosub boat 1410 gosub delay:gosub delay:clearw 2 1420 input w$ 1430 if w$="boat" or w$="sailboat" then gosub rightanswer:return 1440 gosub wronganswer 1450 goto 1360 1460 question8: 1470 ? "You might use this in your" 1480 ? "yard or garden." 1490 ?:?:?:? 1500 gosub rake 1510 gosub delay:gosub delay:clearw 2 1520 input w$ 1530 if w$="rake" then gosub rightanswer:return 1540 gosub wronganswer 1550 goto 1460 1560 question9: 1570 ? "What can you use to" 1580 ? "untangle your hair?" 1590 ?:?:?:? 1600 gosub comb 1610 gosub delay:gosub delay:clearw 2 1620 input w$ 1630 if w$="comb" then gosub rightanswer:return 1640 gosub wronganswer 1650 goto 1560 1660 question10: 1670 ? "What shape is this?" 1680 ?:?:?:? 1690 gosub circ 1700 gosub delay:gosub delay:clearw 2 1710 input w$ 1720 if w$="circle" or w$="round" then gosub rightanswer:return 1730 gosub wronganswer 1740 goto 1660 1750 question11: 1760 ? " What color is the spot?" 1770 ?:?:?:? 1780 gosub redspot 1790 gosub delay:gosub delay:clearw 2 1800 input w$ 1810 if w$="red" then gosub rightanswer:return 1820 gosub wronganswer 1830 goto 1750 1840 question12: 1850 ? " What do you use to ride" 1860 ? " in the snow?" 1870 ?:?:?:? 1880 gosub sled 1890 gosub delay:gosub delay:clearw 2 1900 input w$ 1910 if w$="sled" then gosub rightanswer:return 1920 gosub wronganswer 1930 goto 1840 1940 question13: 1950 ? "What color is the spot?" 1960 ?:?:?:? 1970 gosub bluespot 1980 gosub delay:gosub delay:clearw 2 1990 input w$ 2000 if w$="blue" then gosub rightanswer:return 2010 gosub wronganswer 2020 goto 1940 2030 question1A: 2040 ? "You might wear this on" 2050 ? "your foot. What is it?" 2060 ?:?:?:? 2070 gosub shoe 2080 gosub delay:gosub delay:clearw 2 2090 input w$ 2100 if w$="shoe" or w$="slipper" then gosub rightanswer:return 2110 gosub wronganswer 2120 goto 2030 2130 question1B: 2140 ? " Turn on the ______!" 2150 ?:?:?:? 2160 gosub lamp 2170 gosub delay:gosub delay:clearw 2 2180 input w$ 2190 if w$="lamp" or w$="light" then gosub rightanswer:return 2200 gosub wronganswer 2210 goto 2130 2220 question1C: 2230 ? "You might wear these." 2240 ?:?:?:? 2250 gosub pants 2260 gosub delay:gosub delay:clearw 2 2270 input w$ 2280 if w$="pants" or w$="trousers" or w$="jeans" then gosub rightanswer:return 2290 gosub wronganswer 2300 goto 2220 2310 question1D: 2320 ? " You can carry water in this." 2330 ?:?:?:? 2340 gosub pail 2350 gosub delay:gosub delay:clearw 2 2360 input w$ 2370 if w$="pail" or w$="bucket" then gosub rightanswer:return 2380 gosub wronganswer 2390 goto 2310 2400 question1E: 2410 ? "Many big plants like this" 2420 ? "grow in the woods." 2430 ? "What is it?" 2440 ?:?:?:? 2450 gosub tree 2460 gosub delay:gosub delay:clearw 2 2470 input w$ 2480 if w$="tree" then gosub rightanswer:return 2490 gosub wronganswer 2500 goto 2400 2510 question1F: 2520 ? " You might go camping with this." 2530 ?:?:?:? 2540 gosub tent 2550 gosub delay:gosub delay:clearw 2 2560 input w$ 2570 if w$="tent" then gosub rightanswer:return 2580 gosub wronganswer 2590 goto 2510 2600 question1G: 2610 ? " You can tell time with this." 2620 ?:?:?:? 2630 gosub watch 2640 gosub delay:gosub delay:clearw 2 2650 input w$ 2660 if w$="watch" or w$="wristwatch" then gosub rightanswer:return 2670 gosub wronganswer 2680 goto 2600 2690 delay: 2700 for d=1 to 1500:next d:return 2710 dudsound: 2720 wave 1,1,1,4096 2730 sound 1,10,1,3,40 2740 sound 1,0,0,0,0 2750 return 2760 winsound: 2770 for i=1 to 3 2780 wave 1,1,12,0,0 2790 sound 1,10,1,6,15 2800 sound 1,0,0,0,0 2810 next i 2820 return 2830 redbus: 2840 linef 130,130,130,160 2850 linef 130,160,200,160 2860 linef 130,130,200,130 2870 linef 200,130,200,160 2880 linef 140,130,140,140 2890 linef 130,140,200,140 2900 circle 140,160,6 2910 circle 190,160,6 2920 linef 130,130,133,128 2930 linef 200,130,197,128 2940 linef 197,128,133,128 2950 color 1,2,1,1,1 2960 fill 131,159 2970 fill 133,129 2980 color 1,1,1,1,1 2990 fill 141,161 3000 fill 140,159 3010 fill 190,161 3020 fill 190,159 3030 return 3040 WATCH: 3050 CIRCLE 150,145,20 3060 LINEF 75,140,75,150 3070 LINEF 75,140,131,140 3080 LINEF 75,150,131,150 3090 LINEF 225,140,225,150 3100 LINEF 225,140,169,140 3110 LINEF 225,150,169,150 3120 LINEF 150,145,150,158 3130 LINEF 150,145,165,145 3140 COLOR 1,0,1,1,1 3150 COLOR 1,4,1,6,2 3160 FILL 76,141 3170 FILL 224,141 3180 COLOR 1,2,1,1,1 3190 FILL 150,140 3200 RETURN 3210 CAR: 3220 LINEF 97,150,102,140 3230 LINEF 151,140,151,150 3240 LINEF 95,150,200,150 3250 LINEF 95,150,100,140 3260 LINEF 200,150,195,140 3270 LINEF 100,140,195,140 3280 LINEF 125,140,135,130 3290 LINEF 175,140,170,130 3300 LINEF 170,130,135,130 3310 LINEF 170,132,134,132 3320 'THE ABOVE LINE DRAWS THE ROOF 3330 LINEF 150,132,150,140 3340 LINEF 152,132,152,140 3350 CIRCLE 115,150,5 3360 CIRCLE 185,150,5 3370 COLOR 1,4,1,1,1 3380 FILL 136,141 3390 FILL 156,141 3400 FILL 115,149 3410 FILL 185,149 3420 FILL 150,131 3430 COLOR 1,1,1,1,1 3440 FILL 115,151 3450 FILL 185,151 3460 LINEF 151,140,151,150 3470 RETURN 3480 HOUSE: 3490 H=20:W=50 3500 X=125:Y=145 3510 GOSUB BOX 3520 H=10:W=10 3530 X=140:Y=155 3540 GOSUB BOX 3550 H=5:W=5 3560 X=165:Y=155 3570 GOSUB BOX 3580 LINEF 125,145,150,130 3590 LINEF 175,145,150,130 3600 COLOR 1,10,1,2,2 3610 FILL 126,146 3620 COLOR 1,4,1,4,2 3630 FILL 150,131 3640 COLOR 1,14,1,1,1 3650 FILL 145,160 3660 FILL 169,156 3670 RETURN 3680 'THIS SUBROUTINE PLOTS A BOX OF HEIGHT H, WIDTH W, ULH CORNER 3690 'AT POINT X,Y 3700 BOX: 3710 LINEF X,Y,X+W,Y 3720 LINEF X+W,Y,X+W,Y+H 3730 LINEF X+W,Y+H,X,Y+H 3740 LINEF X,Y+H,X,Y 3750 RETURN 3760 ROCKET: 3770 H=20:W=70 3780 X=125:Y=145 3790 GOSUB BOX 3800 LINEF 125,145,100,155 3810 LINEF 100,155,125,165 3820 LINEF 200,150,210,150 3830 LINEF 200,155,210,155 3840 LINEF 200,160,210,160 3850 COLOR 1,8,1,1,1 3860 FILL 105,155 3870 FILL 126,155 3880 RETURN 3890 BOAT: 3900 LINEF 150,130,150,155 3910 LINEF 150,130,195,150 3920 LINEF 150,150,195,150 3930 CIRCLE 160,143,5 3940 COLOR 1,2,1,1,1 3950 FILL 160,143 3960 COLOR 1,3,1,1,1 3970 FILL 151,140 3980 LINEF 95,155,135,165 3990 LINEF 95,155,205,155 4000 LINEF 205,155,195,165 4010 LINEF 135,165,195,165 4020 FILL 150,156 4030 RETURN 4040 RAKE: 4050 LINEF 225,145,90,145 4060 LINEF 90,130,90,160 4070 LINEF 90,130,80,130 4080 LINEF 90,160,80,160 4090 LINEF 90,155,80,155 4100 LINEF 90,150,80,150 4110 LINEF 90,145,80,145 4120 LINEF 90,140,80,140 4130 LINEF 90,135,80,135 4140 RETURN 4150 COMB: 4160 LINEF 110,125,190,125 4170 LINEF 110,125,105,135 4180 LINEF 190,125,195,135 4190 LINEF 105,135,195,135 4200 COLOR 1,2,1,1,1 4210 FILL 150,131 4220 LINEF 115,135,115,150 4230 LINEF 110,135,110,150 4240 LINEF 105,135,105,150 4250 LINEF 120,135,120,150 4260 LINEF 125,135,125,150 4270 LINEF 130,135,130,150 4280 LINEF 135,135,135,150 4290 LINEF 140,135,140,150 4300 LINEF 145,135,145,150 4310 LINEF 150,135,150,150 4320 LINEF 155,135,155,150 4330 LINEF 160,135,160,150 4340 LINEF 165,135,165,150 4350 LINEF 170,135,170,150 4360 LINEF 175,135,175,150 4370 LINEF 180,135,180,150 4380 LINEF 185,135,185,150 4390 LINEF 190,135,190,150 4400 LINEF 195,135,195,150 4410 RETURN 4420 RACKET: 4430 CIRCLE 120,145,20 4440 CIRCLE 120,145,18 4450 COLOR 1,1,1,12,3 4460 FILL 120,145 4470 LINEF 140,145,195,145 4480 LINEF 165,146,194,146 4490 LINEF 165,144,194,144 4500 RETURN 4510 REDSPOT: 4520 CIRCLE 150,145,20 4530 COLOR 1,2,1,1,1 4540 FILL 150,145 4550 RETURN 4560 GOSUB DELAY:GOSUB DELAY:GOSUB DELAY 4570 BLUESPOT: 4580 CIRCLE 150,145,20 4590 COLOR 1,4,1,1,1 4600 FILL 150,145 4610 RETURN 4620 CIRC: 4630 CIRCLE 150,145,20 4640 CIRCLE 150,145,15 4650 COLOR 1,3,1,1,1 4660 FILL 167,145 4670 RETURN 4680 boot: 4690 linef 170,165,170,130 4700 linef 170,130,150,130 4710 linef 150,130,150,150 4720 linef 150,150,145,155 4730 linef 145,155,135,160 4740 linef 135,160,130,165 4750 linef 130,165,155,165 4760 linef 155,165,160,160 4770 linef 165,160,170,160 4780 linef 160,160,165,160 4790 linef 165,160,165,165 4800 linef 165,165,170,165 4810 color 1,9,1,5,2 4820 fill 140,163 4830 color 1,1,1,1,1 4840 fill 166,164 4850 return 4860 shoe: 4870 linef 170,165,170,155 4880 linef 170,155,150,155 4890 linef 150,155,140,160 4900 linef 140,160,120,163 4910 linef 120,163,120,165 4920 linef 120,165,155,165 4930 linef 155,165,160,163 4940 linef 160,163,170,163 4950 linef 155,165,170,165 4960 color 1,2,1,1,1 4970 fill 130,162 4980 color 1,1,1,1,1 4990 fill 169,164 5000 linef 147,157,155,158 5010 linef 155,158,165,158 5020 linef 165,158,170,155 5030 linef 144,158,150,160 5040 linef 142,160,148,162 5050 return 5060 lamp: 5070 linef 140,125,160,125 5080 linef 140,125,135,150 5090 linef 160,125,165,150 5100 linef 135,150,165,150 5110 linef 150,150,150,165 5120 linef 151,150,151,165 5130 linef 149,150,149,165 5140 linef 140,165,160,165 5150 linef 140,164,160,164 5160 color 1,14,1,1,1 5170 fill 150,140 5180 linef 145,164,145,162 5190 return 5200 pants: 5210 linef 140,125,135,165 5220 linef 140,125,160,125 5230 linef 160,125,165,165 5240 linef 165,165,155,165 5250 linef 135,165,145,165 5260 linef 145,165,150,135 5270 linef 155,165,150,135 5280 color 1,4,1,4,2 5290 fill 150,126 5300 linef 150,125,150,135 5310 linef 152,125,152,132 5320 linef 152,132,150,135 5330 linef 140,124,160,124 5340 return 5350 PAIL: 5360 LINEF 135,140,165,140 5370 LINEF 135,140,135,145 5380 LINEF 165,140,165,145 5390 LINEF 165,145,160,165 5400 LINEF 135,145,140,165 5410 LINEF 160,165,140,165 5420 COLOR 1,1,1,1,1 5430 FILL 141,164 5440 CIRCLE 150,140,15 5450 CIRCLE 150,140,12 5460 FILL 150,127 5470 RETURN 5480 TREE: 5490 CIRCLE 150,140,15 5500 COLOR 1,3,1,14,2 5510 FILL 150,140 5520 LINEF 147,154,147,165 5530 LINEF 153,154,153,165 5540 LINEF 153,165,147,165 5550 COLOR 1,1,1,4,2 5560 FILL 152,164 5570 RETURN 5580 TENT: 5590 LINEF 90,165,150,125 5600 LINEF 210,165,150,125 5610 LINEF 150,125,150,165 5620 LINEF 180,165,180,145 5630 LINEF 120,165,120,145 5640 LINEF 150,125,140,165 5650 LINEF 150,125,130,165 5660 LINEF 120,165,180,165 5670 COLOR 1,3,1,1,1 5680 FILL 130,140 5690 FILL 155,140 5700 COLOR 1,11,1,1,1 5710 FILL 135,160 5720 COLOR 1,1,1,3,2 5730 FILL 149,145 5740 LINEF 90,165,90,162 5750 LINEF 210,165,210,162 5760 RETURN 5770 SLED: 5780 LINEF 165,140,110,140 5790 LINEF 110,140,125,155 5800 LINEF 125,155,180,155 5810 LINEF 180,155,165,140 5820 COLOR 1,1,1,5,3 5830 FILL 150,145 5840 COLOR 1,1,2,1,1 5850 LINEF 125,155,125,165 5860 LINEF 110,140,110,150 5870 LINEF 180,155,180,165 5880 LINEF 190,165,110,165 5890 LINEF 110,165,105,160 5900 LINEF 105,160,105,155 5910 LINEF 120,150,95,150 5920 LINEF 95,150,90,145 5930 LINEF 90,145,90,140 5940 COLOR 1,0,1,1,1 5950 RETURN 5960 '--------------------------- 5970 AESINIT:'Initialize for aes 5980 def seg=0 : aes#=GB 5990 control=peek(aes#) 6000 global=peek(aes#+4) 6010 gintin=peek(aes#+8) 6020 gintout=peek(aes#+12) 6030 addrin#=peek(aes#+16) 6040 addrout#=peek(aes#+20) 6050 ' gemsys(10) 'APPL_INIT - NOT NEEDED - Done by Basic 6060 gemsys(77) 'GRAF_HANDLE 6070 handle=peek(gintout) 6080 return 6090 ' 6100 ' 6110 '----------------------------------------- 6120 FORMALERT:'Put a selection of 1-3 items in box 6130 'Output: 6140 ' CHOICE% - which box was selected 6150 'Input (all must be set before calling this routine) 6160 ' (none of the strings may contain '[' or ']') 6170 ' DEFAULT% - value from 0-3; choice used if user hits return 6180 ' ICON% - 0=blank, 1="!", 2="?", 3="STOP" 6190 ' TEXT$ - text string (up to 20 chars per line);'|' is a new line 6200 ' CHOICES$ - text string with up to 3 choices (choices separated by '|') 6210 ' if one choice, it may have up to 20 chars 6220 ' if 2 choices, each may have up to 9 chars 6230 ' if 3 choices, each may have up to 5 chars 6240 ' 6250 aesmenu$=str$(icon%)+"]["+text$+"]["+choices$+"]"+chr$(0)+chr$(0) 6260 def seg=0 : amenuaddr!=varptr(aesmenu$) 'For Interpreter 6270 if INTERPRETER then goto formcontinue1 6280 ' The following 2 lines are used only by the LDW compiler 6290 ' since VARPTR works differently for it on strings 6300 amadr#=amenuaddr!:def seg=amenuaddr!:poke 0,0 6310 def seg=0:amenuaddr!=peek(amadr#) 6320 formcontinue1: 6330 poke gintin,default% 'Choice selected if user hits RETURN 6340 poke addrin#,amenuaddr! 6350 gemsys(52) 6360 choice%=peek(gintout) 6370 return 6380 ' 6390 '------------------------------- 6400 INITIALIZE: ' General initializations (replaces VDI\VOPNVWK) 6410 copyright$="Copyright 1986 Chris Williams / AccuSoft" 6420 dummy%=switch(3) 'Used by LDW Compiler 6430 INTERPRETER=1:COMPILER=0 'If using ST Interpreter 6440 if switch(3)=3 then INTERPRETER=0:COMPILER=1 'If using LDW Compiler 6450 ' Screen Resolution data 6460 LOW=0 : MEDIUM=0 : HIGH=0 6470 if peek(systab)=1 then HIGH=1 6480 if peek(systab)=2 then MEDIUM=1 6490 if peek(systab)=4 then LOW=1 6500 ' 6510 if HIGH then xres%=640:yres%=400:colors%=2:return 6520 if MEDIUM then xres%=640:yres%=200:colors%=4:return 6530 if LOW then xres%=320:yres%=200:colors%=16:return 6540 return 'Undefined resolution 6550 ' ə